home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / AMOS1.DMS / in.adf / Compiler.AMOS / Compiler.amosSourceCode < prev    next >
Encoding:
AMOS Source Code  |  1991-09-09  |  20.3 KB  |  806 lines
  1. '----------------------------------  
  2. ' AMOS Compiler shell accessory
  3. ' V 1.1
  4. ' By Fran�ois Lionet 
  5. ' (c) Europress Software Ltd. 1991 
  6. '----------------------------------  
  7. '
  8. Global PATH$,DPATH$,PRAM$,CNAME$,FLAG$,FACC,CFLASH$
  9. '
  10. CNAME$="Compiler_Configuration"
  11. PRAM$="RAM:AMOS_Compiler_Temp"
  12. DPATH$=":AMOS_System"
  13. VER$="1.1"
  14. '
  15. ' Colour to flash when un-squashing compiled programs. >31 for no flash
  16. ' Read Welcome text file for more infos... 
  17. CFLASH$="-Z32"
  18. '
  19. ' Enough RAM?
  20. Close Workbench 
  21. Close Editor 
  22. Set Sprite Buffer 48
  23. If Chip Free+Fast Free<80*1024
  24.    Screen Open 0,640,24,2,Hires : Colour 1,$FFF : Curs Off 
  25.    Centre ">>> Sorry, the compiler needs at least 80 Kbytes free to run. <<<"
  26.    Print : Print : Centre "Press any key"
  27.    Wait Key : Edit 
  28. End If 
  29. '
  30. ' Get the directories
  31. On Error Proc _NO_DISC
  32. If Exist(PRAM$+"/"+CNAME$)
  33.    DPATH$=PRAM$
  34.    Open In 1,PRAM$+"/Compiler_Origin"
  35.    Input #1,PATH$
  36.    Close 
  37. End If 
  38. '  
  39. Break Off 
  40. Change Mouse 4+6
  41. _UNPACK_FADE[10,0,2]
  42. _UNPACK_ICONS
  43. _UNPACK_INFO
  44. _LOAD_CONFIGURATION
  45. _SET_ZONES
  46. For B=1 To 3
  47.    _ANIMATE_BUTTON[B,0]
  48. Next 
  49. NOINFO
  50. _RESET_COMPILE
  51. '
  52. ' Load ACmp program
  53. On Error Proc _FATAL_DISC_ERROR
  54. If Not Extension_5_00AE 
  55.    INFO['>>> Loading "ACmp" program <<<']
  56.    If PATH$<>""
  57.        Extension_5_0098 PATH$+"/ACmp"
  58.    Else 
  59.        Extension_5_0098 DPATH$+"/ACmp"
  60.    End If 
  61.    NOINFO
  62. End If 
  63. '
  64. ' Copy into ram-disc?
  65. _GETFLAG[5]
  66. If Param
  67.    If Exist("Ram:")
  68.       If DPATH$<>PRAM$
  69.          _COPY_FOLDER[DPATH$,PRAM$]
  70.          If Param
  71.             PATH$=Dir$ : C=Instr(PATH$,":") : PATH$=Left$(PATH$,C-1)+DPATH$
  72.             Open Out 1,PRAM$+"/Compiler_Origin"
  73.             Print #1,PATH$
  74.             Close 
  75.             DPATH$=PRAM$
  76.          End If 
  77.       End If 
  78.    End If 
  79. End If 
  80. '
  81. ' Menu loop
  82. Do 
  83.    Repeat 
  84.       Multi Wait 
  85.       Z=Mouse Zone
  86.       If Mouse Key=2
  87.          INFO[">>> Compiler shell version "+VER$+" -"+Str$(Chip Free+Fast Free+17000)+" bytes free to compile. <<<"]
  88.          While Mouse Key=2 : Wend 
  89.          NOINFO
  90.          Wait 16
  91.       End If 
  92.    Until Z<>0 and Mouse Key=1
  93.    _ANIMATE_BUTTON[Z,-1]
  94.    While Mouse Key : Wend 
  95.    If Z=4 : _COMPILE : End If 
  96.    If Z=5 : _THEEND : End If 
  97. Loop 
  98. '
  99. Procedure _COMPILE
  100.    '
  101.    On Error Proc _GENERAL_DISC_ERROR
  102.    Resume Label _FINISH_COMPILE
  103.    '
  104.    _INIT_COMPILE
  105.    Screen Close 1
  106.    '
  107.    Do 
  108.       _GETFLAG[1] : C$=" -D"+Mid$(Str$(Param),2)
  109.       S$=Fsel$("*.AMOS","","Please choose program to compile.","QUIT to abort compilation.")
  110.       If S$="" : INFO[">>> Compilation cancelled. <<<"] : KWAIT : Goto _FINISH_COMPILE : End If 
  111.       '
  112.       _GETFLAG[2] : C$=C$+Mid$(Str$(Param),2)
  113.       D$=Fsel$("**","","Please choose destination file name.",'"OK" for default name.')
  114.       If D$=""
  115.          _GETFLAG[3]
  116.          If Upper$(Right$(S$,5))=".AMOS"
  117.             If Param<2
  118.                D$=Left$(S$,Len(S$)-5)
  119.             Else 
  120.                D$=Left$(S$,Len(S$)-5)+"_C.AMOS"
  121.             End If 
  122.          End If 
  123.       End If 
  124.       Exit If D$<>""
  125.       INFO[">>> Please choose a .AMOS program, or enter object name. <<<"]
  126.       KWAIT : NOINFO
  127.    Loop 
  128.    '
  129.    _GETFLAG[3] : TYPE=Param : If TYPE=2 : TYPE=3 : End If 
  130.    '  
  131.    C$='"'+S$+'"'+C$+" -O"+'"'+D$+'"'
  132.    _GETFLAG[10] : C$=C$+" -S"+Mid$(Str$(Param),2)
  133.    _GETFLAG[9] : C$=C$+" -E"+Mid$(Str$(Param),2)
  134.    _GETFLAG[8] : C$=C$+" -W"+Mid$(Str$(Param),2)
  135.    _GETFLAG[4] : If TYPE=1 : Add TYPE,Param : End If 
  136.    _GETFLAG[12] : If Param : C$=C$+" -L" : End If 
  137.    C$=C$+" -T"+Mid$(Str$(TYPE),2)
  138.    C$=C$+" -F"+DPATH$+"/"+" -C"+DPATH$+"/"+CNAME$
  139.    C$=C$+" "+CFLASH$
  140.    '
  141.    Timer=0 : Extension_5_006E C$,$12345678 : E$= Extension_5_0078 
  142.    T=Timer/50 : M=T/60 : S=T mod 60
  143.    '
  144.    If E$=""
  145.       SZ= Extension_5_00BE 
  146.       A$="Object size:"+Str$(SZ)+" bytes -"+Str$( Extension_5_00BE )+" instructions - Compiled in"
  147.       If M : A$=A$+Str$(M)+" M." : End If 
  148.       A$=A$+Str$(S)+" Second" : If S>1 : A$=A$+"s" : End If 
  149.       A$=A$+"."
  150.       INFO[A$]
  151.       _GETFLAG[11]
  152.       If Param<>0 and TYPE<>3
  153.          KWAIT
  154.          INFO[">>> Squashing program. Press CONTROL-C to cancel squashing <<<"]
  155.          DD$=D$+"_Temp"
  156.          _SQUASH_A_PROG[D$,DD$,1]
  157.          If Param>0
  158.             A$=">>> Successfull squash, final size:"+Str$(Param)+","+Str$(SZ-Param)+" bytes saved. <<<"
  159.             INFO[A$]
  160.          Else 
  161.             If Param=0
  162.                INFO[">>> Squash interrupted. <<<"]
  163.             End If 
  164.             If Param<0
  165.                INFO[">>> Un-successfull squash, no object file on disc. <<<"]
  166.             End If 
  167.          End If 
  168.          On Error Proc _SKIP_DISC_ERROR
  169.          Resume Label NOKIL1
  170.          Kill D$
  171.          NOKIL1:
  172.          Resume Label NOKIL2
  173.          Rename DD$ To D$
  174.          NOKIL2:
  175.       End If 
  176.    Else 
  177.       A$=">>> "+E$+" <<<" : INFO[A$]
  178.    End If 
  179.    KWAIT
  180.    '
  181.    _FINISH_COMPILE:
  182.    _UNPACK_ICONS
  183.    _RESET_COMPILE
  184.    NOINFO : Screen 0
  185. End Proc
  186. Procedure _NO_DISC
  187.    Screen Open 0,640,24,2,Hires : Colour 1,$FFF : Curs Off 
  188.    Centre "I cannot reach the crucial files from your disc,"
  189.    Print : Centre "please read the manual for more informations."
  190.    Print : Centre ">>> Press any key <<<"
  191.    Wait Key : Edit 
  192. End Proc
  193. Procedure _FATAL_DISC_ERROR
  194.    INFO[">>> Disc error: AMOS_System MUST be in the CURRENT drive. <<<"]
  195.    KWAIT
  196.    _THEEND
  197. End Proc
  198. Procedure _GENERAL_DISC_ERROR
  199.    Close 
  200.    INFO[">>> Disc error, check your disc drive and free space on disc. <<<"]
  201.    KWAIT
  202.    Resume Label 
  203. End Proc
  204. Procedure _SKIP_DISC_ERROR
  205.    Resume Label 
  206. End Proc
  207. Procedure _RESET_COMPILE
  208.    LX=72 : Y3=92
  209.    Bob Off 1 : Update 
  210.    Synchro On : Update On 
  211.    Make Mask 1
  212.    For X=0 To 9*23 Step 9
  213.       Paste Bob LX+X,Y3,1
  214.    Next 
  215.    Wait Vbl 
  216.    OX=192 : DX=16
  217.    Screen Copy 1,OX,34,OX+72,34+33 To 0,DX,Y3
  218. End Proc
  219. Procedure _INIT_COMPILE
  220.    OX=192 : DX=16 : Y3=92 : LX=72
  221.    For N=1 To 6 : Make Mask N : Next 
  222.    Wait Vbl : Screen Copy 1,OX,68,OX+72,68+33 To 0,DX,Y3
  223.    Set Bob 1,-1,, : Bob 1,LX,Y3,1
  224.    Channel 1 To Bob 1
  225.    A$=A$+"      Let RA=0; Let RB=0; Let R0=0; Let A=1;"
  226.    A$=A$+"Loop: If RA<>RB Jump More;"
  227.    A$=A$+"      Pause; Jump Loop;"
  228.    A$=A$+"More: Let R0=R0+1; If R0=6 Jump Plus;"
  229.    A$=A$+"      Let A=A+1; Jump Again;"
  230.    A$=A$+"Plus: Let R0=0; Let X=X+9; Let A=1;"
  231.    A$=A$+"Again:Let RB=RB+1; Pause;"
  232.    A$=A$+"      Jump Loop;"
  233.    Amal 1,A$
  234.    Amal On 
  235.    Wait 5
  236.    Synchro Off : Update Off 
  237. End Proc
  238. Procedure _LOAD_CONFIGURATION
  239.    On Error Proc _SKIP_DISC_ERROR
  240.    Resume Label NOLOAD
  241.    '
  242.    Do 
  243.       A$=">>> Cannot load configuration file. <<<"
  244.       If Exist(DPATH$+"/"+CNAME$)
  245.          A$=">>> Configuration file corrupted. <<<"
  246.          INFO[">>> Loading "+CNAME$+" <<<"]
  247.          Open In 1,DPATH$+"/"+CNAME$ : L=Lof(1) : Close 
  248.          Erase 9 : Reserve As Work 9,L
  249.          Bload DPATH$+"/"+CNAME$,Start(9)
  250.          CONF=Hunt(Start(9) To Start(9)+Length(9),"[")+1
  251.          If CONF
  252.             If Chr$(Peek(CONF+60))="]"
  253.                FLAG$=Space$(12)
  254.                For C=0 To Len(FLAG$)-1
  255.                   Poke Varptr(FLAG$)+C,Peek(CONF+C)
  256.                Next 
  257.                FLAG=True
  258.             End If 
  259.          End If 
  260.       End If 
  261.       Erase 9
  262.       Exit If FLAG
  263.       Goto KIPS
  264.       '
  265.       NOLOAD: A$=">>> Cannot load configuration file. <<<"
  266.       KIPS: INFO[A$] : KWAIT : NOINFO
  267.       CNAME$=Fsel$("Compiler_Configuratio**","","Please select a configuration to load.","Click on SET DIR before leaving.")
  268.       If CNAME$="" : _THEEND : End If 
  269.       _GET_DISCNAME[CNAME$] : CNAME$=Param$
  270.    Loop 
  271.    NOINFO
  272. End Proc
  273. Procedure _SAVE_CONFIGURATION
  274.    On Error Proc _GENERAL_DISC_ERROR
  275.    Resume Label _NOSAVE
  276.    '
  277.    If Exist(DPATH$+"/"+CNAME$)
  278.       Open In 1,DPATH$+"/"+CNAME$ : L=Lof(1) : Close 
  279.       Erase 9 : Reserve As Work 9,L
  280.       Bload DPATH$+"/"+CNAME$,Start(9)
  281.       CONF=Hunt(Start(9) To Start(9)+Length(9),"[")+1
  282.       For C=1 To Len(FLAG$)
  283.          Poke CONF,Asc(Mid$(FLAG$,C,1)) : Inc CONF
  284.       Next 
  285.       Bsave DPATH$+"/"+CNAME$,Start(9) To Start(9)+L
  286.       If PATH$<>""
  287.          Bsave PATH$+"/"+CNAME$,Start(9) To Start(9)+L
  288.       End If 
  289.       Erase 9
  290.       FLAG=True
  291.    End If 
  292.    _NOSAVE:
  293.    If FLAG=0
  294.       INFO[">>> Cannot save configuration file. <<<"]
  295.       KWAIT
  296.    End If 
  297. End Proc
  298. Procedure _GET_DISCNAME[N$]
  299.    For N=Len(N$) To 1 Step -1
  300.       A$=Mid$(N$,N,1)
  301.       Exit If(A$="/") or(A$=":")
  302.    Next 
  303.    N$=Mid$(N$,N+1)
  304. End Proc[N$]
  305. Procedure _GETFLAG[N]
  306. End Proc[Asc(Mid$(FLAG$,N,1))-48]
  307. Procedure _SETFLAG[N,V]
  308.    Mid$(FLAG$,N)=Chr$(48+V)
  309. End Proc
  310. Procedure _ANIMATE_BUTTON[Z,FLAG]
  311.    '
  312.    Shared _ORIGIN,_DEST,_TYPE
  313.    Y1=48 : Y2=134
  314.    '
  315.    On Z Gosub Z1,Z2,Z3,Z4,Z5,Z6,Z7
  316.    Pop Proc
  317.    '  
  318.    Z1:
  319.    If FLAG
  320.       _GETFLAG[1] : _SETFLAG[1,1-Param]
  321.    End If 
  322.    _GETFLAG[1] : OX=Param*64 : DX=16 : Goto ZZ
  323.    Z2:
  324.    If FLAG
  325.       _GETFLAG[2] : _SETFLAG[2,1-Param]
  326.    End If 
  327.    _GETFLAG[2] : OX=Param*64 : DX=128 : Goto ZZ
  328.    Z3:
  329.    If FLAG
  330.       _GETFLAG[3] : F=Param
  331.       Add F,1,0 To 2
  332.       _SETFLAG[3,F]
  333.    End If 
  334.    _GETFLAG[3] : OX=Param*64+128 : DX=240 : Goto ZZ
  335.    Z4: Return 
  336.    Z5: OX=0 : DX=16 : Goto CB
  337.    Z6: OX=64 : DX=128
  338.    Wait Vbl : Screen Copy 1,OX,68,OX+64,68+34 To 0,DX,Y2
  339.    Wait 10 : Wait Vbl 
  340.    Screen Copy 1,OX,34,OX+64,34+34 To 0,DX,Y2
  341.    '
  342.    Auto View Off : Unpack 13 To 2 : For N=0 To 31 : Colour N,0 : Next 
  343.    Screen Display 2,164,100,, : Screen To Back : Screen Hide 3
  344.    Auto View On : Wait Vbl 
  345.    Screen 0 : Fade 1 : Wait 16
  346.    Screen 2 : Screen To Front : Fade 1 To 1
  347.    KWAIT
  348.    Fade 1 : Wait 16 : Screen To Back 
  349.    Screen 0 : Fade 1 To 1 : Wait 16 : Screen Show 3
  350.    Screen Close 2
  351.    Wait Vbl : Screen Copy 1,OX,34,OX+64,34+34 To 0,DX,Y2
  352.    Return 
  353.    Z7: OX=128 : DX=240 : Gosub CB
  354.    _SETUP_MENU : Return 
  355.    '
  356.    ' Animates the clickable buttons 
  357.    CB:
  358.    Wait Vbl 
  359.    Screen Copy 1,OX,68,OX+64,68+34 To 0,DX,Y2
  360.    Wait 10 : Wait Vbl 
  361.    Screen Copy 1,OX,34,OX+64,34+34 To 0,DX,Y2
  362.    Return 
  363.    '
  364.    ' Animates the drop buttons  
  365.    ZZ:
  366.    Screen 1 : Get Bob 9,OX,0 To OX+63,33 : No Mask 9 : Screen 0
  367.    Set Bob 2,-1,, : Bob 2,DX,Y1-32,9 : Limit Bob 2,0,Y1 To 320,Y1+32 : Update 
  368.    Channel 2 To Bob 2
  369.    Amal 2,"Move 0,32,8; Move 0,-4,4; Move 0,4,4;"
  370.    Amal On : While Chanmv(2) : Wait Vbl : Wend 
  371.    Bob Off : Del Bob 9
  372.    Update 
  373.    Return 
  374. End Proc
  375. Procedure _THEEND
  376.    If DPATH$=PRAM$
  377.       _GETFLAG[6]
  378.       If Param=0
  379.          INFO[">>> Deleting compiler work folder from ram-disc <<<"]
  380.          _DELETE_FOLDER[PRAM$]
  381.          NOINFO : Wait 8
  382.       End If 
  383.    End If 
  384.    _GETFLAG[7] : If Param=0 : Extension_5_00A0 : End If 
  385.    Fade 1 : Wait 16
  386.    Screen Close 3
  387.    Screen Close 1
  388.    Screen Close 0
  389.    Edit 
  390. End Proc
  391. Procedure _DELETE_FOLDER[S$]
  392.    Dim FILE$(64),NC$(2)
  393.    On Error Proc _SKIP_DISC_ERROR
  394.    Resume Label _SKIP
  395.    '
  396.    Set Dir ,""
  397.    If Upper$(Left$(S$,4))<>"RAM:"
  398.       INFO[">>> Warning! I do not want to delete:"+S$+"! <<<"] : KWAIT
  399.    Else 
  400.       '
  401.       A$=Dir First$(S$+"/**")
  402.       While A$<>""
  403.          FILE$(N)=Left$(A$,30)-" " : Inc N
  404.          A$=Dir Next$
  405.       Wend 
  406.       If N
  407.          For C=0 To N-1
  408.             Kill S$+"/"+FILE$(C)
  409.          Next 
  410.       End If 
  411.       Kill S$
  412.    End If 
  413.    '
  414.    _SKIP:
  415. End Proc
  416. Procedure _COPY_FOLDER[S$,D$]
  417.    Dim FILE$(64),NC$(5)
  418.    On Error Proc _FATAL_DISC_ERROR
  419.    '
  420.    INFO[">>> Copying AMOS_System folder onto ram-disc. <<<"]
  421.    NC$(0)="W.LIB"
  422.    NC$(1)="ACMP"
  423.    NC$(2)="AMOS1_2_PAL.ENV"
  424.    NC$(3)="AMOS1_2_NTSC.ENV"
  425.    NC$(4)="AMOS1_2.ENV"
  426.    NC$(5)="COMPILER_CONFIGURATION.LARGE"
  427.    NCOP=5
  428.    Set Dir ,""
  429.    A$=Dir First$(S$+"/**")
  430.    While A$<>""
  431.       B$=Left$(A$,30)-" "
  432.       Do 
  433.          For NC=0 To NCOP
  434.             Exit If Upper$(B$)=NC$(NC),2
  435.          Next 
  436.          FILE$(N)=B$
  437.          TL=TL+Val(Mid$(A$,30))
  438.          Inc N
  439.          Exit 
  440.       Loop 
  441.       A$=Dir Next$
  442.    Wend 
  443.    If Chip Free+Fast Free<TL+100*1024
  444.       INFO[">>> Not enough free ram to copy libraries to the ram-disc. <<<"]
  445.       KWAIT
  446.       Goto _NORAM
  447.    End If 
  448.    Mkdir D$
  449.    If N
  450.       For C=0 To N-1
  451.          A$=S$+"/"+FILE$(C) : B$=D$+"/"+FILE$(C)
  452.          I$=">>> Copying: "+FILE$(C)+" to ram-disc <<<" : INFO[I$]
  453.          _FCOPY[A$,B$]
  454.       Next 
  455.    End If 
  456.    F=-1
  457.    _NORAM:
  458.    NOINFO
  459.    Set Dir ,".info/*.info/*.*.info"
  460. End Proc[F]
  461. Procedure _FCOPY[S$,D$]
  462.    On Error Proc _FATAL_DISC_ERROR
  463.    Open In 1,S$
  464.    Open Out 2,D$
  465.    LF=Lof(1)
  466.    Do 
  467.       Exit If P>=LF
  468.       L=Min(1024,LF-P)
  469.       A$=Input$(1,L)
  470.       Print #2,A$;
  471.       Add P,L
  472.    Loop 
  473.    Close 1
  474.    Close 2
  475. End Proc
  476. Procedure _SET_ZONES
  477.    NZ=7
  478.    Reserve Zone NZ
  479.    ' Set up zones 
  480.    For Z=1 To NZ
  481.       Read A,B,C,D : Set Zone Z,A,B To C,D
  482.    Next 
  483.    Data 16,48,79,80
  484.    Data 128,48,191,80
  485.    Data 240,48,303,80
  486.    Data 16,93,88,123
  487.    Data 16,134,79,166
  488.    Data 128,134,191,166
  489.    Data 240,134,303,166
  490. End Proc
  491. Procedure _UNPACK_ICONS
  492.    Auto View Off 
  493.    Unpack 12 To 1 : Screen Hide 1
  494.    Auto View On : _MOUSE_PALETTE
  495.    Screen 0
  496. End Proc
  497. Procedure _UNPACK_FADE[BK,SC,SP]
  498.    Dim C(31)
  499.    Auto View Off 
  500.    Unpack BK To SC : Screen Hide : _MOUSE_PALETTE : View : Wait Vbl 
  501.    For N=0 To 31
  502.       C(N)=Colour(N) : Colour N,0
  503.    Next 
  504.    Screen Show : View : Wait Vbl 
  505.    Fade SP,C(0),C(1),C(2),C(3),C(4),C(5),C(6),C(7),C(8),C(9),C(10),C(11),C(12),C(13),C(14),C(15),C(16),C(17),C(18),C(19)
  506.    Wait SP*16
  507.    _MOUSE_PALETTE
  508.    Auto View On 
  509. End Proc
  510. Procedure _UNPACK_INFO
  511.    Auto View Off 
  512.    Unpack 11 To 3 : Screen Hide 
  513.    Screen Display 3,,228,, : View 
  514.    _MOUSE_PALETTE : For N=0 To 15 : Colour N,0 : Next 
  515.    Screen Show 
  516.    Auto View On 
  517. End Proc
  518. Procedure _MOUSE_PALETTE
  519.    For C=16 To 31
  520.       Colour C,0
  521.    Next 
  522.    For C=16 To 24
  523.       Read CC
  524.       Colour C,CC
  525.    Next 
  526.    Data $0,$FFF,$FD0,$F90,$FC8,$DA4,$C70,$940,$F00
  527. End Proc
  528. Procedure _MAKE_SETUP_SCREEN
  529.    Fade 1 : Wait 16
  530.    Auto View Off 
  531.    Unpack 11 To 3 : Screen Hide 3 : _MOUSE_PALETTE
  532.    Screen Open 1,640,200,8,Hires
  533.    Curs Off : Flash Off : For C=0 To 31 : Colour C,0 : Next 
  534.    Screen Copy 3,0,0,640,8 To 1,0,0
  535.    For Y=8 To 192 Step 8
  536.       Screen Copy 3,0,9,640,9+8 To 1,0,Y
  537.    Next 
  538.    Screen Copy 3,0,21-8,640,21 To 1,0,192
  539.    Auto View On 
  540.    Fade 1 To 3
  541.    _UNPACK_INFO
  542.    Screen To Back 3
  543.    Screen 1
  544. End Proc
  545. Procedure _SETUP_MENU
  546.    Dim JMP$(64),ZIT(64),ITZ(64),ZBASE(64)
  547.    _MAKE_SETUP_SCREEN
  548.    Paper 6 : Pen 7 : Ink 5
  549.    PAGE=1
  550.    ' Handle menu
  551.    MK_MENU:
  552.    Curs Off : Gosub DR_MENU
  553.    NOZ=1
  554.    Do 
  555.       Repeat 
  556.          Multi Wait 
  557.          Z=Mouse Zone : K=Mouse Key
  558.          If Z<>OLDZ
  559.             If OLDZ>0 : ACT=-1 : IT=ZIT(OLDZ) : OLDZ=-1 : Gosub DR_ITEM : End If 
  560.             If Z>0 : OLDZ=Z : ACT=Z : IT=ZIT(Z) : ZNE=ZBASE(IT) : Gosub DR_ITEM : End If 
  561.          End If 
  562.       Until Z<>0 and K<>0
  563.       If JMP$(Z)<>"" : Gosub JMP$(Z) : End If 
  564.       ACT=Z : ZNE=ZBASE(IT) : Gosub DR_ITEM
  565.       If K=1 : Repeat : Multi Wait : Until Mouse Key=0 : End If 
  566.    Loop 
  567.    '  
  568.    MN_BACK:
  569.    Pop 
  570.    Fade 1 : Wait 16
  571.    _UNPACK_ICONS
  572.    Screen 0 : Fade 1 To 1
  573.    Pop Proc
  574.    '
  575.    MN_SAVE:
  576.    Timer=0
  577.    INFO[">>> Saving configuration file <<<"]
  578.    Wait 8 : Screen To Front 3 : Wait 8
  579.    _SAVE_CONFIGURATION
  580.    Repeat : Until Timer>50
  581.    Screen To Back 3
  582.    NOINFO
  583.    Screen 1
  584.    Return 
  585.    '
  586.    ST_FLAG: V=1-V : Gosub "POK"+VTYPE$ : Return 
  587.    ' Draw menu page 
  588.    DR_MENU:
  589.    Reserve Zone 64
  590.    IT=0 : ZNE=1 : NOZ=0 : ACT=-1 : OLDPAR=-1
  591.    Repeat 
  592.       Inc IT : ZBASE(IT)=ZNE : Gosub DR_ITEM
  593.    Until FLAG=False
  594.    Return 
  595.    ' Draw one menu item 
  596.    DR_ITEM:
  597.    LAB$="L"+(Str$(PAGE)-" ")+"_"+(Str$(IT)-" ")
  598.    On Error Goto NO_IT
  599.    Restore LAB$ : Read IT$
  600.    On Error 
  601.    M=0 : XX=-1
  602.    Repeat 
  603.       NEND=Instr(IT$,"|",M+1)
  604.       ENC=0 : LBL$="" : FL=0 : ZZ=0 : NB=0
  605.       Repeat 
  606.          N=M+1
  607.          M=Instr(IT$,",",N) : M2=Instr(IT$,":",N) : If M>M2 : M=0 : End If 
  608.          If M=0 or(NEND<>0 and M1>NEND) : M=M2 : FL=1 : End If 
  609.          A$=Upper$(Mid$(IT$,N,1)) : Inc N
  610.          If A$="E" : ENC=1 : End If 
  611.          If A$="L" : Gosub GT_STR : LBL$=A$ : Inc ZZ : End If 
  612.          If A$="C" : CNT=1 : End If 
  613.          If A$="X" : Gosub GT_STR : XX=Val(A$) : End If 
  614.          If A$="Y" : Gosub GT_STR : YY=Val(A$) : End If 
  615.       Until FL
  616.       If NEND
  617.          A$=Mid$(IT$,M+1,NEND-M-1)
  618.       Else 
  619.          A$=Mid$(IT$,M+1)
  620.       End If 
  621.       Gosub DR_WORD
  622.       M=NEND
  623.    Until NEND=0
  624.    FLAG=True
  625.    Return 
  626.    '
  627.    DR_WORD:
  628.    If XX<0 : XX=40-Len(A$)/2 : End If 
  629.    Locate XX,YY
  630.    '
  631.    FST=0
  632.    If Left$(A$,1)="&"
  633.       Inc FST
  634.       B$=Upper$(Mid$(A$,2,1)) : A$=Mid$(A$,3)
  635.       If B$="F"
  636.          Gosub GT_VAL
  637.          A$="  No   " : If V : A$="  Yes  " : End If 
  638.       End If 
  639.    End If 
  640.    '
  641.    X1=X Graphic(XX)-3 : Y1=Y Graphic(YY)-2 : X2=X Graphic(XX+Len(A$))+2 : Y2=Y1+11
  642.    '
  643.    If ZZ<>0 or NOZ=0 or FST<>0
  644.       Inverse Off : If ZZ<>0 and ACT=ZNE : Inverse On : End If 
  645.       Print A$;
  646.       If ENC<>0 and NOZ=0 : Box X1,Y1 To X2,Y2 : End If 
  647.    End If 
  648.    If ZZ<>0
  649.       If NOZ=0
  650.          Set Zone ZNE,X1,Y1 To X2,Y2
  651.          ZIT(ZNE)=IT : ITZ(IT)=ZNE
  652.          If LBL$<>""
  653.             JMP$(ZNE)=LBL$
  654.          End If 
  655.       End If 
  656.       Inc ZNE
  657.    End If 
  658.    XX=XX+(X2-X1)/8+1
  659.    Return 
  660.    '
  661.    NO_IT: Resume NO_IT2
  662.    NO_IT2: FLAG=False
  663.    Return 
  664.    '
  665.    GT_STR:
  666.    A$=Mid$(IT$,N,M-N)
  667.    Return 
  668.    '
  669.    GT_VAL:
  670.    VTYPE$=Left$(A$,1) : ADV=Val(Mid$(A$,2))
  671.    Goto "PIK"+VTYPE$
  672.    PIKF: _GETFLAG[ADV] : V=Param : Return 
  673.    POKF: _SETFLAG[ADV,V] : Return 
  674.    '
  675.    ' Datas page 1 
  676.    L1_1: Data "C,Y1,E:         Compiled program setup         "
  677.    L1_2: Data "Y3,X6:- Include error messages?|X66,E,LSt_Flag:&FF09"
  678.    L1_3: Data "Y5,X6:- Create default screen?|X66,E,LSt_Flag:&FF10"
  679.    L1_4: Data "Y7,X6:- Send AMOS TO BACK upon booting?|X66,E,LSt_Flag:&FF08"
  680.    L1_5: Data "Y9,X6:- CLI programs to run in the background?|X66,E,LSt_Flag:&FF04"
  681.    L1_6: Data "Y11,X6:- Long forward jumps (option -L for VERY long programs)?|X66,E,LSt_Flag:&FF12"
  682.    L1_7: Data "C,Y13,E:             Compiler setup             "
  683.    L1_8: Data "Y15,X6:- Copy all libraries onto ram-disc?|X66,E,LSt_Flag:&FF05"
  684.    L1_9: Data "Y17,X6:- Leave libraries on ram-disc upon exiting?|X66,E,LSt_Flag:&FF06"
  685.    L1_10: Data 'Y19,X6:- Keep compiler program "ACmp" in memory upon exiting?|X66,E,LSt_Flag:&FF07'
  686.    L1_11: Data "Y21,X6:- Squash compiled program?|X66,E,LSt_Flag:&FF11"
  687.    L1_12: Data "E,X72,Y23,LMn_Back: Exit "
  688.    L1_13: Data "E,X45,Y23,LMn_Save: Save this configuration "
  689. End Proc
  690. Procedure _SQUASH_A_PROG[S$,D$,FIRST]
  691.    '
  692.    On Error Proc _GENERAL_DISC_ERROR
  693.    Resume Label SQERROR
  694.    '
  695.    Open In 1,S$
  696.    Open Out 2,D$
  697.    '
  698.    HEAD1$=Input$(1,12)
  699.    NHUNK=Leek(Varptr(HEAD1$)+8)
  700.    HEAD2$=Input$(1,4*(2+NHUNK))
  701.    '
  702.    Print #2,HEAD1$;
  703.    Print #2,HEAD2$;
  704.    '
  705.    For H=0 To NHUNK-1
  706.       FLAG=True : If FIRST<>0 and H=0 and NHUNK>1 : FLAG=0 : End If 
  707.       Gosub SQHUNK
  708.       Exit If BRK
  709.       Loke Varptr(HEAD2$)+4*(2+H),HH
  710.    Next 
  711.    '
  712.    If BRK=0
  713.       Pof(2)=12
  714.       Print #2,HEAD2$;
  715.       LPROG=Lof(2)
  716.       Close 
  717.    Else 
  718.       Close 
  719.       Kill D$
  720.       LPROG=0
  721.    End If 
  722.    Goto SQEND
  723.    '
  724.    SQERROR:
  725.    On Error Proc _SKIP_DISC_ERROR
  726.    Resume Label KK
  727.    Kill D$
  728.    KK: LPROG=-1
  729.    Goto SQEND
  730.    '
  731.    SQHUNK:
  732.    H$=Input$(1,8) : Pof(1)=Pof(1)-8
  733.    HH=Leek(Varptr(H$)) and $C0000000
  734.    LP=Leek(Varptr(H$)+4) : HH=HH or LP : Rol.l 2,LP
  735.    Add LP,8+4
  736.    F=0
  737.    '
  738.    Erase 8 : Reserve As Work 8,LP+16
  739.    '
  740.    OLDPOF=Pof(1)
  741.    '
  742.    _ONCE_AGAIN:
  743.    AP=Start(8) : P=0
  744.    Repeat 
  745.       L=2048 : If P+L>LP : L=LP-P : End If 
  746.       A$=Input$(1,L)
  747.       Copy Varptr(A$),Varptr(A$)+L To AP
  748.       Add P,L : Add AP,L
  749.    Until P>=LP
  750.    '
  751.    AP=Start(8)
  752.    '
  753.    If FLAG<>0 and F=0
  754.       If Leek(AP)<>$78566467
  755.          '
  756.          L= Extension_5_00CE(AP+8,LP-12,-1,512,17)
  757.          If L=-1
  758.             Pof(1)=OLDPOF : F=-1 : Goto _ONCE_AGAIN
  759.          End If 
  760.          If L=-2 : BRK=-1 : Goto _ABORT : End If 
  761.          '  
  762.          LH=(L+3) and $FFFFFFFC
  763.          Copy AP+8,AP+8+LH To AP+8+12
  764.          Loke AP+8,$78566467 : Loke AP+12,LP : Loke AP+16,L
  765.          Add LH,12 : Loke AP+4,LH/4
  766.          HH=(HH and $C0000000) or(LH/4)
  767.          Loke AP+8+LH,$3F2
  768.          LP=8+LH+4
  769.       End If 
  770.    End If 
  771.    '
  772.    A$=Space$(2048) : P=0
  773.    Repeat 
  774.       L=2048 : If P+L>LP : L=LP-P : End If 
  775.       Copy AP,AP+L To Varptr(A$)
  776.       Print #2,Left$(A$,L);
  777.       Add P,L : Add AP,L
  778.    Until P>=LP
  779.    '
  780.    _ABORT:
  781.    Erase 8
  782.    Return 
  783.    '
  784.    SQEND:
  785. End Proc[LPROG]
  786. Procedure INFO[A$]
  787.    Screen 3
  788.    Ink 6 : Bar 6,4 To Screen Width-8,Screen Height-4
  789.    Ink 7,6 : L=Text Length(A$) : Text 320-L/2,12,A$
  790.    _MOUSE_PALETTE : Fade 1,$0,$F00,$E60,$DA0,$DA0,$DD0,$C,$EEE : Wait 8
  791.    Screen 0
  792. End Proc
  793. Procedure NOINFO
  794.    Screen 3 : Fade 1,0,0,0,0,0,0,0,0 : Wait 8 : Screen 0
  795. End Proc
  796. Procedure KWAIT
  797.    Bell 
  798.    Update On : Hide On 
  799.    Repeat 
  800.       Sprite 8,X Mouse,Y Mouse,8
  801.       Multi Wait 
  802.    Until Mouse Key
  803.    While Mouse Key : Wend 
  804.    Sprite Off : Wait Vbl 
  805.    Show On 
  806. End Proc